{$V-}
UNIT WTCHART;
{***************************************************************}
{*                                                             *}
{*   Copyright (c) Quinn-Curtis, 1992                          *}
{*                                                             *}
{*   Filename:  RTCHART.PAS                                    *}
{*   Revision:  3.0                                            *}
{*   Date:      2/3/92                                        *}
{*                                                             *}
{*   Description: -Routines for standard charting including    *}
{*                  autoscaling, line plots, bar charts        *}
{*                  scatterplots, window labeling &            *}
{*                  window titling                             *}
{*                                                             *}
{***************************************************************}
INTERFACE
USES
  Objects, WinProcs, WinTypes, Strings,
  wtstdhdr, wtarray, wtgsubs;

TYPE
  PRTChart = ^TRTChart;
  TRTChart = object(TRT)

PROCEDURE RTRoundAxes(VAR a1, a2,tics : REALTYPE);
PROCEDURE RTAutoAxes(win: RTStatPntr;  datasetx,datasety : TPOINTER_C;
                    numdat, AxFlag :  INTEGER );
PROCEDURE RTLinePlotData(win: RTStatPntr; datasetx,datasety : TPOINTER_C;
                        numdat, color, linestyle, linewidth :  INTEGER);
(*
PROCEDURE RTSetScatMarkRelSize(marksize: RealType);
PROCEDURE RTPolyLineRel(x,y: RTMarkerType; numdat: INTEGER);
PROCEDURE RTScatterPlotData(win: RTStatPntr;  datasetx,datasety : TPOINTER_C;
                           numdat, color,marktype:  INTEGER);
PROCEDURE RTLabelPlotArea(win: RTStatPntr; x,y:REALTYPE;
                         GrLabel :string; xjust, yjust: INTEGER );
*)
PROCEDURE RTLabelGraphWindow(win: RTStatPntr;  x,y :REALTYPE;
                         GrLabel: string;
                         xjust,  yjust:INTEGER );
PROCEDURE RTTitleXAxis(win: RTStatPntr;  XTitle : string );
PROCEDURE RTTitleYAxis(win: RTStatPntr;  YTitle : string );
PROCEDURE RTTitleWindow(win: RTStatPntr;  GTitle : string );

Constructor Init( numwin, dowinint, gmaxx, gmaxy: INTEGER);
Destructor Done; virtual;

end; { TRTChart type definition }

IMPLEMENTATION

Const
      markrelsize: RealType = 1.0;

PROCEDURE TRTChart.RTRoundAxes(VAR a1, a2,tics : REALTYPE);
VAR
  dr1, dr2,  px2, pc2 : REALTYPE;
  a2neg, a1neg, di1, di2,  digits : INTEGER;
BEGIN

  a1neg := ORD(a1 < 0);
  a2neg := ORD(a2 > 0);
  IF (RTNumExp(a2) > RTNumExp(a1)) THEN
    px2 := RTNumExp(a2) - 1
  ELSE
    px2 := RTNumExp(a1) - 1;
  pc2 := PowerCalc(10.0, px2);
  dr2 := a2 / pc2;
  dr1 := a1 / pc2;

  di2 :=  trunc(dr2 + (dr2-dr1)*0.05);
  IF di2 > 0 THEN di2 := di2 + 1;
  IF (di2 > 0) AND (dr2 <= 0.0) THEN di2 := 0;

  di1 := trunc(dr1 - (dr2-dr1)*0.05);
  IF di1 < 0 THEN di1 := di1 - 1;
  IF (di1< 0) AND (dr1 >= 0.0) THEN di1 := 0;


  IF abs(di2) < 10 THEN
    di2 := ((di2 DIV 5)+a2neg) * 5
  ELSE IF abs(di2) < 60 THEN
    di2 := ((di2 DIV 5)+a2neg) * 5
  ELSE IF abs(di2) < 100 THEN
     di2 := ((di2 DIV 10)+a2neg) * 10
  ELSE
     di2 := ((di2 DIV 10)+a2neg) * 10;

  IF abs(di1)<10 THEN
    di1 := ((di1 DIV 5) -a1neg) * 5
  ELSE IF abs(di1) < 60 THEN
    di1 := ((di1 DIV 5) -a1neg) * 5
  ELSE IF abs(di1) < 100 THEN
    di1 := ((di1 DIV 10) - a1neg) * 10
  ELSE
    di1 := ((di1 DIV 10)-a1neg) * 10;
  a1 := di1 * pc2;
  a2 := di2 * pc2;
  digits := abs(di2 - di1);
  IF digits < 10 THEN
    tics := (digits) / 5.0
  ELSE IF digits < 20 THEN
    tics := 2.0
  ELSE IF digits < 50 THEN
    tics := 5.0
  ELSE IF digits < 80 THEN
    tics := 10.0
  ELSE IF digits < 100 THEN
    tics := 20.0
  ELSE IF digits < 151 THEN
    tics := 20.0
  ELSE IF digits < 200 THEN
    tics := 50.0
  ELSE
    tics := 100.0;
  tics := tics * (pc2) / 10 ;
END;

PROCEDURE TRTChart.RTAutoAxes(win: RTStatPntr;  datasetx,datasety : TPOINTER_C;
                    numdat, AxFlag :  INTEGER );
VAR
   rr,ll,tt,bb,xx1, yy1, xx2, yy2, ts1, ts2, xi, yi : REALTYPE;
   xdecs,ydecs,lsx, lsy, dirx, diry : INTEGER;
BEGIN
  RTSDRVp(win);
  SetTextStyle(win^.curFont,0,win^.curFontSize);
  dirx := 0;
  diry := 0;
  RTFindMinMax(datasetx, numdat, xx1, xx2);
  RTFindMinMax(datasety, numdat, yy1, yy2);
  RTRoundAxes( xx1, xx2, ts1);
  RTRoundAxes( yy1, yy2, ts2);
  IF (AxFlag = 0) THEN
  BEGIN
    IF (xx2 >= 0.0) AND (xx1 >= 0.0) THEN
            xi := xx1;
    IF (xx2 >= 0.0) AND (xx1 < 0.0) THEN
            xi := 0.0;
    IF (xx2 <= 0.0) AND (xx1 <= 0.0) THEN
    BEGIN
      xi := xx2;
      diry := 1
    END;
    IF (yy2 >= 0.0) AND (yy1 >= 0.0) THEN
            yi := yy1;
    IF (yy2 >= 0.0) AND (yy1 < 0.0) THEN
            yi := 0.0;
    IF (yy2 <= 0.0) AND (yy1 <= 0.0) THEN
    BEGIN
      yi := yy2;
      dirx := 1
    END;
  END
  ELSE
  BEGIN
    xi := xx1;
    yi := yy1;
  END;
  win^.yint := yi;
  win^.xint := xi;
  IF win^.pr.right-win^.pr.left > 400 THEN lsx := 10 else lsx := 20;
  IF abs(win^.pr.top-win^.pr.bottom) < 75 THEN lsy := 20 else
    lsy := 10;
  xdecs := RTCalcDecs(xx1,xx2);
  ydecs := RTCalcDecs(yy1,yy2);
  ll  :=(rtcalclabelwidth(yy1,yy2,ydecs)+rtth(3.0))/ rtviewportwidth;
  rr := ll;
  bb := (rtcalcticxpix(1)+rtth(4.0))/ rtviewportheight;
  tt := (rtth(4.0))/ rtviewportheight;
  RTSetWin2PlotRatio(win,ll,tt,rr,bb);
  RTScalePlotArea(win,xx1, yy1, xx2, yy2);

  RTSetXYIntercepts(win,xx1, yi);
  RTDrawYAxis(win,ts2, 0);
  RTLabelYAxis(win,lsy, ydecs,0);

  RTSetXYIntercepts(win,xx2, yi);
  RTDrawYAxis(win,ts2, 1);
  RTLabelYAxis(win,lsy, ydecs,1);

  RTSetXYIntercepts(win,xx1, yi);
  RTDrawXAxis(win,ts1, 0);
  IF (yi <> yy1) THEN
  BEGIN
    RTSetXYIntercepts(win,xx1, yy1);
    RTDrawXAxis(win,ts1, 0);
  END;
  RTLabelXAxis(win,lsx, xdecs,0);

END;

PROCEDURE TRTChart.RTLinePlotData(win: RTStatPntr; datasetx,datasety : TPOINTER_C;
                        numdat, color, linestyle, linewidth :  INTEGER);

var oldcolor : integer;
BEGIN
  oldcolor := GetColor;
  RTSetColor(color);
  SetLineStyle( linestyle, 0, linewidth );
  RTSPCW(win);
  RTpolyLineWorldAbs(datasetx, datasety, numdat);
  RTSPWW(win);
  SetLineStyle( solidln, 0, 1 );
  RTSetColor(oldcolor);
END;
(*
PROCEDURE TRTChart.RTSetScatMarkRelSize(marksize: RealType);
BEGIN
  markrelsize := marksize;
END;

PROCEDURE TRTChart.RTPolyLineRel(x,y: RTMarkerType; numdat: INTEGER);
VAR i: INTEGER;
BEGIN
  _moverel(round(x[0]),round(y[0]));
  FOR i := 1 to numdat-1 do
    _linerel(round(x[i]),round(y[i]));
END;

PROCEDURE TRTChart.RTScatterPlotData(win: RTStatPntr; datasetx,datasety : TPOINTER_C;
                           numdat, color,marktype     :  INTEGER);
CONST
      MarkerX : ARRAY[0..5,0..10] OF RealType =
     ((-0.5,0.0,1.0,0.0,-1.0,0.0,0.0,0.0,0.0,0.0,0.0),
      (-0.5,0.5,0.5,-1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0),
      (0.0,-0.5,0.5,0.5,-0.5,0.0,0.0,0.0,0.0,0.0,0.0),
      (-0.5,1.0,-0.5,-0.5,1.0,0.0,0.0,0.0,0.0,0.0,0.0),
      (0.0,0.0,0.0,-0.5,1.0,0.0,0.0,0.0,0.0,0.0,0.0),
      (0.0,0.0,0.0,-0.5,1.0,-0.5,-0.5,1.0,-0.5,0.5,-1.0));

      MarkerY : ARRAY[0..5,0..10] OF RealType =
      ((-0.5,1.0,0.0,-1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0),
       (-0.5,1.0,-1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0),
       (-0.5,0.5,0.5,-0.5,-0.5,0.0,0.0,0.0,0.0,0.0,0.0),
       (-0.5,1.0,-0.5,0.5,-1.0,0.0,0.0,0.0,0.0,0.0,0.0),
       (-0.5,1.0,-0.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0),
       (-0.5,1.0,-0.5,0.0,0.0,0.0,0.5,-1.0,0.5,0.5,-1.0));

MarkerNum : ARRAY[0..6] of INTEGER =
       (5,4,5,5,5,11,5);

VAR
  i,kk,oldcolor,msint : INTEGER;
  pfx, pfy : RTMarkerType;
  pfsfx, pfsfy,msfx : RealType;

BEGIN
  oldcolor := getcolor;
  RTSetColor(color);
  IF marktype>5 THEN marktype:=0;
  RTSPCW(win);
  pfsfx := abs(RTPlotAreaPWidth(win)) * 0.015*markrelsize;
  pfsfy := abs(RTPlotAreaPHeight(win)) * 0.015*markrelsize;
  IF (pfsfx > pfsfy) THEN
    msfx := pfsfx
  ELSE
    msfx := pfsfy;
  msfx := Int(msfx);
  msint := trunc(msfx);
  if (msint MOD 2 <> 0) THEN
    msfx := msfx + 1.0;
  kk := markernum[markType];
  FOR i := 0 TO kk-1 DO
  BEGIN
    pfx[i] := MarkerX[markType, i] * Round(msfx);
    pfy[i] := MarkerY[markType, i] * Round(msfx);
  END;
  FOR i := 0 TO numdat - 1 DO
  BEGIN
    RTMoveWorldAbs(datasetx.GetPntrReal(i), datasety.GetPntrReal(i));
    RTPolyLineRel(pfx, pfy, kk);
  END;
  RTSPWW(win);
  RTSetColor(oldcolor);
END;

PROCEDURE TRTChart.RTLabelPlotArea(win: RTStatPntr; x,y :REALTYPE;
                         GrLabel : string;
                         xjust,  yjust  :INTEGER );
BEGIN
  RTSPWW(win);
  SetTextJustify(xjust,yjust);
  RTMoveWorldAbs(x, y);
  OutText(GrLabel);
  SetTextJustify(0,0);
END;
*)
PROCEDURE TRTChart.RTLabelGraphWindow(win: RTStatPntr; x,y :REALTYPE;
                         GrLabel : string;
                         xjust,  yjust:INTEGER );
BEGIN
  RTSDRVp(win);
  RTSetWorldCoordinates(0.0,0.0,1000.0,1000.0);
  SetTextJustify( xjust, yjust );
  RTMoveWorldAbs((x), (y));
  OutText(GrLabel);
  RTSPWW(win);
  SetTextJustify( LeftText, CenterText);
END;

PROCEDURE TRTChart.RTTitleXAxis(win: RTStatPntr; XTitle : string );
VAR
   x, y : REALTYPE;
   textInfo: TextSettingsType;
BEGIN
  GetTextSettings(textInfo);
  SetTextStyle(textInfo.font,0,textinfo.charsize);
  x := 500.0;
  y := -50.0;
  RTLabelGraphWindow(win,x, y, XTitle, 1, 0);
  SetTextStyle(textInfo.font,textInfo.direction,textinfo.charsize);
END;


PROCEDURE TRTChart.RTTitleYAxis(win: RTStatPntr; YTitle : string );
VAR
   x, y : REALTYPE;
   textInfo: TextSettingsType;
BEGIN
  GetTextSettings(textInfo);
  SetTextStyle(textInfo.font,1,textinfo.charsize);
  x := 10.0;
  y := 500.0;
  RTLabelGraphWindow(win,x, y, YTitle, 1, 1);
  SetTextStyle(textInfo.font,textInfo.direction,textinfo.charsize);
END;

PROCEDURE TRTChart.RTTitleWindow(win: RTStatPntr; GTitle : string );
VAR
   x, y : REALTYPE;
   textInfo: TextSettingsType;
BEGIN
  GetTextSettings(textInfo);
  SetTextStyle(textInfo.font,0,textinfo.charsize);
  x := 500.0;
  y := 990.0;
  RTLabelGraphWindow(win,x, y, GTitle, 1, 2);
  SetTextStyle(textInfo.font,textInfo.direction,textinfo.charsize);
END;

Constructor TRTChart.Init( numwin, dowinint, gmaxx, gmaxy:integer);
begin TRT.Init( numwin, dowinint, gmaxx, gmaxy); end;

Destructor TRTChart.Done;
begin TRT.Done; end;

BEGIN

END.
